home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Demos / AirHockey / modDplay.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-08  |  7.7 KB  |  194 lines

  1. Attribute VB_Name = "modDplay"
  2. Option Explicit
  3. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  4.  
  5. 'We want to keep the amount of data we send down to a bare minimum.  Use the lowest
  6. 'data type we can.  For example, even though Enums are by default Long's
  7. 'We will never have more than 255 messages for this application so we will convert
  8. 'them all to bytes when we send them
  9. Public Enum vbDplayHockeyMsgType
  10.     MsgSendGameSettings 'The settings for the application to run under
  11.     MsgPaddleLocation 'The location of a particular paddle
  12.     MsgPuckLocation 'The location of the puck
  13.     MsgPlayerScored 'Someone just scored
  14.     MsgClientConnectedAndReadyToPlay 'The client is connected, has received the game settings and is ready to play
  15.     MsgRestartGame 'Time to restart the game
  16.     MsgCollidePaddle 'Used only for sound effects...
  17. End Enum
  18.  
  19. 'Constants
  20. Public Const AppGuid = "{AC35AAB4-32D3-465d-96C3-4F4137FBF9A1}"
  21. 'Minimum frequency to allow sending data (in ms)
  22. 'Regardless of network latency, we never want to send more than 20 msgs/second
  23. 'which equates to a minimum send frequency of 50
  24. Public Const glMinimumSendFrequency As Long = 1000 \ 20
  25. 'Main Peer object
  26. Public dpp As DirectPlay8Peer
  27. 'PlayerID of the user who is connected
  28. Public glOtherPlayerID As Long
  29.  
  30. 'App specific variables
  31. Public gsUserName As String
  32. 'Our connection form and message pump
  33. Public DPlayEventsForm As DPlayConnect
  34. 'How often we should send our paddles information
  35. Public glSendFrequency As Long
  36. 'The amount of latency between two systems
  37. '(calculated as Avg(RoundTripLatency)/2)
  38. Public glOneWaySendLatency As Long
  39. 'We have disconnected from the session.  Stop sending data
  40. Public gfNoSendData As Boolean
  41.  
  42. Public Sub InitDPlay()
  43.     'Create our DX/DirectPlay objects
  44.     If dx Is Nothing Then Set dx = New DirectX8
  45.     Set dpp = dx.DirectPlayPeerCreate
  46.     glSendFrequency = glMinimumSendFrequency
  47. End Sub
  48.  
  49. Public Sub CleanupDPlay()
  50.     On Error Resume Next
  51.     If Not (DPlayEventsForm Is Nothing) Then
  52.         If Not (dpp Is Nothing) Then dpp.UnRegisterMessageHandler
  53.         DPlayEventsForm.DoSleep 50
  54.         'Get rid of our message pump
  55.         DPlayEventsForm.GoUnload
  56.         'Close down our session
  57.         If Not (dpp Is Nothing) Then dpp.Close
  58.         'Lose references to peer and dx objects
  59.         Set dpp = Nothing
  60.         Set dx = Nothing
  61.     End If
  62. End Sub
  63.  
  64. Public Sub UpdateNetworkSettings()
  65.  
  66.     Dim lMsg As Long, lNumMsg As Long, lNumByte As Long
  67.     Dim lOffset As Long, oBuf() As Byte
  68.     Static lLastSendTime As Long
  69.     Static lLastSendCount As Long
  70.     
  71.     On Error Resume Next 'in case we are already in this sub when we receive our connection terminated message
  72.     If gfGameOver Then Exit Sub
  73.     If gfNoSendData Then Exit Sub
  74.     If Not gfGameCanBeStarted Then Exit Sub
  75.     'First lets check the current send queue information.  IF the queue is building up,
  76.     'then we need to bump up the frequency so we don't oversaturate our line.
  77.     dpp.GetSendQueueInfo glOtherPlayerID, lNumMsg, lNumByte
  78.     If lNumMsg > 3 Or lNumByte > 256 Then
  79.         'We are sending data to fast, slow down
  80.         glSendFrequency = glSendFrequency + glMinimumSendFrequency
  81.     End If
  82.     'Here we will send the current game state (puck, and paddle information), and we will send this information
  83.     'not faster than the glSendFrequency (which will be throttled according to latency)
  84.     If timeGetTime - lLastSendTime > glSendFrequency Then
  85.         If gfHost Then
  86.             lLastSendCount = lLastSendCount + 1
  87.             'We will not send the puck every time
  88.             If lLastSendCount > 3 Then
  89.                 'Update puck
  90.                 'SendPuck 0
  91.                 lLastSendCount = 0
  92.             End If
  93.         End If
  94.         
  95.         'Now send our paddle
  96.         lMsg = MsgPaddleLocation
  97.         AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset 'Msg
  98.         AddDataToBuffer oBuf, CByte(glMyPaddleID), SIZE_BYTE, lOffset 'Paddle ID
  99.         AddDataToBuffer oBuf, goPaddle(glMyPaddleID).Position, LenB(goPaddle(glMyPaddleID).Position), lOffset 'Paddle information
  100.         'We will send this information to the other player only
  101.         dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, 0
  102.         lLastSendTime = timeGetTime
  103.     End If
  104.  
  105. End Sub
  106.  
  107. Public Sub NotifyClientReady()
  108.     Dim lMsg As Long
  109.     Dim lOffset As Long, oBuf() As Byte
  110.     
  111.     If gfNoSendData Then Exit Sub
  112.     If Not gfMultiplayer Then Exit Sub
  113.     If gfHost Then Exit Sub 'Only the client needs to tell the host
  114.     'Here we will tell the host we are ready to play
  115.     lMsg = MsgClientConnectedAndReadyToPlay
  116.     AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
  117.     'We will send this information to the other player only
  118.     dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
  119.     gfGameCanBeStarted = True
  120. End Sub
  121.  
  122. Public Sub NotifyPlayersWeScored()
  123.     Dim lMsg As Long
  124.     Dim lOffset As Long, oBuf() As Byte
  125.     
  126.     If gfNoSendData Then Exit Sub
  127.     If Not gfMultiplayer Then Exit Sub
  128.     If Not gfHost Then Exit Sub
  129.     'Here we will tell the host we are ready to play
  130.     lMsg = MsgPlayerScored
  131.     AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
  132.     'We will send this information to the other player only
  133.     dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
  134. End Sub
  135.  
  136. Public Sub NotifyGameRestart()
  137.     Dim lMsg As Long
  138.     Dim lOffset As Long, oBuf() As Byte
  139.     
  140.     If gfNoSendData Then Exit Sub
  141.     If Not gfMultiplayer Then Exit Sub
  142.     'Here we will tell the host we are ready to play
  143.     lMsg = MsgRestartGame
  144.     AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
  145.     'We will send this information to the other player only
  146.     dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
  147. End Sub
  148.  
  149. Public Sub SendGameSettings()
  150.     Dim lMsg As Long
  151.     Dim lOffset As Long, oBuf() As Byte
  152.     
  153.     If gfNoSendData Then Exit Sub
  154.     If Not gfMultiplayer Then Exit Sub
  155.     If Not gfHost Then Exit Sub
  156.     'Here we will tell the host we are ready to play
  157.     lMsg = MsgSendGameSettings
  158.     AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
  159.     AddDataToBuffer oBuf, gnVelocityDamp, LenB(gnVelocityDamp), lOffset
  160.     AddDataToBuffer oBuf, glUserWinningScore, LenB(glUserWinningScore), lOffset
  161.     AddDataToBuffer oBuf, gnPaddleMass, LenB(gnPaddleMass), lOffset
  162.     'We will send this information to the other player only
  163.     dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
  164. End Sub
  165.  
  166. Public Sub SendPuck(Optional ByVal lFlags As Long = (DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH))
  167.     Dim lMsg As Long
  168.     Dim lOffset As Long, oBuf() As Byte
  169.     
  170.     If gfNoSendData Then Exit Sub
  171.     If Not gfMultiplayer Then Exit Sub
  172.     'Here we will tell the host we are ready to play
  173.     lMsg = MsgPuckLocation
  174.     AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
  175.     AddDataToBuffer oBuf, goPuck.Position, LenB(goPuck.Position), lOffset
  176.     AddDataToBuffer oBuf, goPuck.Velocity, LenB(goPuck.Velocity), lOffset
  177.     'We will send this information to the other player only
  178.     dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, lFlags
  179. End Sub
  180.  
  181. Public Sub SendCollidePaddle()
  182.     Dim lMsg As Long
  183.     Dim lOffset As Long, oBuf() As Byte
  184.     
  185.     If gfNoSendData Then Exit Sub
  186.     If Not gfMultiplayer Then Exit Sub
  187.     'Here we will tell the host we are ready to play
  188.     lMsg = MsgCollidePaddle
  189.     AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
  190.     'We will send this information to the other player only
  191.     dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
  192. End Sub
  193.  
  194.